home *** CD-ROM | disk | FTP | other *** search
Modula Implementation | 1994-09-22 | 19.5 KB | 582 lines |
- IMPLEMENTATION MODULE LongSets;
-
- (*****************************************************************************)
- (* Die Prozeduren werden durch die in MODULA enthaltenen Mengenoperationen, *)
- (* angewendet auf jeweils einzelne BITSETs, implementiert. *)
- (* *)
- (* Um ein bestimmtes Element einer Menge zu selektieren, muessen zwei Dinge *)
- (* getan werden: *)
- (* *)
- (* - Die zum Element gehoerende BITSET muss durch *)
- (* *)
- (* menge[ VAL( CARDINAL, elem ) DIV ElementsInBITSET ] *)
- (* *)
- (* ausgewaehlt werden. *)
- (* *)
- (* - Innerhalb dieser BITSET muss das gewuenschte Element durch *)
- (* *)
- (* VAL( CARDINAL, elem ) MOD ElementsInBITSET *)
- (* *)
- (* ausgewaehlt werden. *)
- (* *)
- (* Da der Typ "Set" aus einzelnen BITSETs zusammengesetzt ist, sind evtl. *)
- (* zusaetzliche Bits vorhanden, wenn "ElementsInSet" kein Vielfaches von 16 *)
- (* ist. Um unerwuenschten Ergebnissen vorzubeugen, falls Bits gesetzt sind, *)
- (* die nicht zur Menge gehoeren, werden diese Bits bei einigen Prozeduren ge-*)
- (* loescht, bzw. die Prozeduren erst gar nicht ausgefuehrt. *)
- (*___________________________________________________________________________*)
- (* *)
- (* 04-Dez-89 , hk *)
- (* Beginn *)
- (* 23-Dez-89 , hk *)
- (* erste Version *)
- (* 05-Jan-90 , hk *)
- (* kleinen Fehler in "IsProperSubset" beseitigt; *)
- (* "WriteSet", "AllElements", "IsFullSet", "IsSuperset", *)
- (* "IsProperSuperset", "Equal" neu *)
- (* 10-Jan-90 , hk *)
- (* Statt ORD( elem ) wird jetzt VAL( CARDINAL, elem ) verwendet, damit*)
- (* fuer DIV und MOD einfache Bitfunktionen verwendet werden, ORD lie- *)
- (* fert leider ein Ergebnis vom Typ INTEGER, sodass fuer DIV und MOD *)
- (* immer Divisionsoperationen verwendet werden ( weil das Teilen ne- *)
- (* gativer Zahlen durch eine Zweierpotenz NICHT durch einen arithme- *)
- (* tischen Rechtsshift erledigt werden kann ). *)
- (* Neue Prozeduren "IncludeRange", "ExcludeRange" *)
- (*****************************************************************************)
-
- FROM SYSTEM IMPORT (* PROC *) VAL, INLINE, SHIFT;
- FROM Terminal IMPORT (* PROC *) Write, WriteLn;
-
- (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
-
- VAR ElemMask : BITSET; (* siehe Modulinit. *)
-
- (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
-
-
- PROCEDURE NoElements ((* -- /AUS *) VAR menge : Set );
- (*T*)
- VAR Index : CARDINAL;
-
- BEGIN
- FOR Index := 0 TO NoOfBITSETs - 1 DO
- menge[ Index ] := {};
- END
- END NoElements;
-
- (*---------------------------------------------------------------------------*)
-
- PROCEDURE AllElements ((* -- /AUS *) VAR menge : Set );
- (*T*)
- VAR Index : CARDINAL;
-
- BEGIN
- FOR Index := 0 TO NoOfBITSETs - 1 DO
- menge[ Index ] := { 0..15 };
- END;
-
- (* Die evtl. zusaetzlichen Bits wieder
- * loeschen.
- *)
- menge[ NoOfBITSETs - 1 ] := menge[ NoOfBITSETs - 1 ] * ElemMask;
-
- END AllElements;
-
- (*---------------------------------------------------------------------------*)
-
- PROCEDURE IsEmptySet ((* EIN/ -- *) menge : Set ): BOOLEAN;
- (*T*)
- VAR Index : CARDINAL;
- Zwischen : BITSET;
-
- BEGIN
- Index := 0;
-
- Zwischen := menge[ NoOfBITSETs - 1 ] * ElemMask;
- menge[ NoOfBITSETs - 1 ] := BITSET{0..15};
-
- (* Dadurch, das in <menge> auf jeden Fall eine nichtleere BITSET-
- * Menge auftritt, kann die Abfrage des Index in der WHILE-
- * Bedingung entfallen.
- *)
- WHILE menge[ Index ] = {} DO
- INC( Index );
- END;
-
- IF Index = NoOfBITSETs - 1 THEN
- (* Wenn <menge> bis hierhin leer ist, entscheidet
- * das letzte BITSET von <menge>, ob sie wirklich
- * leer ist
- *)
- RETURN( Zwischen = {} );
- ELSE
- (* sonst ist schon vorher eine BITSET-Teilmenge
- * nicht leer gewesen
- *)
- RETURN( FALSE );
- END;
-
- END IsEmptySet;
-
- (*---------------------------------------------------------------------------*)
-
- PROCEDURE IsFullSet ((* EIN/ -- *) menge : Set ): BOOLEAN;
- (*T*)
- VAR Index : CARDINAL;
- Zwischen : BITSET;
-
- BEGIN
- Index := 0;
-
- Zwischen := menge[ NoOfBITSETs - 1 ] + ( ElemMask / BITSET{ 0..15 } );
-
- (* Die hinteren ueberfluessigen Bits werden gesetzt,
- * damit auf eine volle BITSET verglichen werden kann
- *)
- menge[ NoOfBITSETs - 1 ] := BITSET{ };
-
- (* Dadurch, das in <menge> auf jeden Fall eine leere BITSET-
- * Menge auftritt, kann die Abfrage des Index in der WHILE-
- * Bedingung entfallen.
- *)
- WHILE menge[ Index ] = { 0..15 } DO
- INC( Index );
- END;
-
- IF Index = NoOfBITSETs - 1 THEN
- (* Wenn <menge> bis hierhin voll ist, entscheidet
- * das letzte BITSET von <menge>, ob sie wirklich
- * voll ist
- *)
- RETURN( Zwischen = { 0..15 } );
- ELSE
- (* sonst ist schon vorher eine BITSET-Teilmenge
- * nicht voll gewesen
- *)
- RETURN( FALSE );
- END;
-
- END IsFullSet;
-
- (*---------------------------------------------------------------------------*)
-
- PROCEDURE Complement ((* EIN/ -- *) menge : Set;
- (* -- /AUS *) VAR compl : Set );
- (*T*)
- VAR Index : CARDINAL;
-
- BEGIN
- FOR Index := 0 TO NoOfBITSETs - 1 DO
- compl[ Index ] := menge[ Index ] / BITSET{0..15};
-
- (* /menge XOR 0FFFFH/ ist das gleiche wie /NOT menge/ *)
- END;
-
- (* Die ueberfluessigen Bits muessen noch
- * geloescht werden.
- *)
- compl[ NoOfBITSETs - 1 ] := compl[ NoOfBITSETs - 1 ] * ElemMask;
-
- END Complement;
-
- (*---------------------------------------------------------------------------*)
-
- PROCEDURE Card ((* EIN/ -- *) menge : Set ): CARDINAL;
- (*T*)
- VAR Elemente,
- Index,
- Bit : CARDINAL;
-
- BEGIN
- (* Sicherheitshalber ueberfluessige Bits loeschen *)
- menge[ NoOfBITSETs - 1 ] := menge[ NoOfBITSETs - 1 ] * ElemMask;
-
- Elemente := 0;
-
- FOR Index := 0 TO NoOfBITSETs - 1 DO
- FOR Bit := 0 TO ElementsInBITSET - 1 DO
- IF Bit IN menge[ Index ] THEN
- INC( Elemente );
- END; (* IF Bit *)
- END; (* FOR Bit *)
- END; (* FOR Index *)
-
- RETURN( Elemente );
-
- END Card;
-
- (*---------------------------------------------------------------------------*)
-
- PROCEDURE IsElement ((* EIN/ -- *) elem : SetElement;
- (* EIN/ -- *) menge : Set ): BOOLEAN;
- (*T*)
- BEGIN
- IF elem <= MAX( SetElement ) THEN
- (* Element nur testen, falls im gueltigen Bereich *)
-
- RETURN( VAL( CARDINAL, elem ) MOD ElementsInBITSET
- IN menge[ VAL( CARDINAL, elem ) DIV ElementsInBITSET ] );
- ELSE
- RETURN( FALSE );
- END;
- END IsElement;
-
- (*---------------------------------------------------------------------------*)
-
- PROCEDURE Include ((* EIN/ -- *) elem : SetElement;
- (* EIN/AUS *) VAR menge : Set );
- (*T*)
- BEGIN
- IF elem <= MAX( SetElement ) THEN
- (* Element nur einfuegen, falls im gueltigen Bereich *)
-
- INCL( menge[ VAL( CARDINAL, elem ) DIV ElementsInBITSET ],
- VAL( CARDINAL, elem ) MOD ElementsInBITSET );
- END;
- END Include;
-
- (*---------------------------------------------------------------------------*)
-
- PROCEDURE Exclude ((* EIN/ -- *) elem : SetElement;
- (* EIN/AUS *) VAR menge : Set );
- (*T*)
- BEGIN
- IF elem <= MAX( SetElement ) THEN
-
- EXCL( menge[ VAL( CARDINAL, elem ) DIV ElementsInBITSET ],
- VAL( CARDINAL, elem ) MOD ElementsInBITSET );
- END;
- END Exclude;
-
- (*---------------------------------------------------------------------------*)
-
- PROCEDURE IncludeRange ((* EIN/ -- *) von,
- (* EIN/ -- *) bis : SetElement;
- (* EIN/AUS *) VAR menge : Set );
- (*T*)
- VAR vonIdx,
- bisIdx : INTEGER;
- vonMaske,
- bisMaske : BITSET;
-
- BEGIN
- IF bis > MAX( SetElement ) THEN
- bis := MAX( SetElement );
- END;
-
- IF von <= bis THEN
-
- (* Erst mal die erste und die letzte BITSET auswaehlen
- *)
-
- vonIdx := VAL( CARDINAL, von ) DIV ElementsInBITSET;
- bisIdx := VAL( CARDINAL, bis ) DIV ElementsInBITSET;
-
- (* Die Masken fuer die gueltigen Bits in der
- * ersten und der letzten BITSET berechnen
- *)
-
- vonMaske := SHIFT( { 0..15 },
- VAL( CARDINAL, von ) MOD ElementsInBITSET );
- bisMaske := SHIFT( { 0..15 },
- VAL( CARDINAL, bis ) MOD ElementsInBITSET - 15 );
-
-
- IF vonIdx = bisIdx THEN
-
- (* Der Bereich liegt innerhalb einer einzigen
- * BITSET; die Make ist daher die Schnittmenge
- * der beiden Einzelmasken
- *)
- menge[ vonIdx ] := menge[ vonIdx ] + ( vonMaske * bisMaske );
- ELSE
-
- (* Die Bits in der ersten und letzten betroffenen
- * BITSET werden entsprechend den Masken gesetzt
- * und alle dazwischenliegenden BITSETs vollstaendig
- * aufgefuellt; besteht der Bereich nur aus zwei
- * BITSETs, wird die Schleife nicht durchlaufen.
- *)
-
- menge[ vonIdx ] := menge[ vonIdx ] + vonMaske;
- menge[ bisIdx ] := menge[ bisIdx ] + bisMaske;
-
- FOR vonIdx := vonIdx + 1 TO bisIdx - 1 DO
-
- menge[ vonIdx ] := BITSET{ 0..15 };
- END; (* FOR *)
-
- END; (* IF vonIdx *)
- END; (* IF von <= *)
- END IncludeRange;
-
- (*---------------------------------------------------------------------------*)
-
- PROCEDURE ExcludeRange ((* EIN/ -- *) von,
- (* EIN/ -- *) bis : SetElement;
- (* EIN/AUS *) VAR menge : Set );
- (*T*) (* wie "IncludeRange *)
- VAR vonIdx,
- bisIdx : INTEGER;
- vonMaske,
- bisMaske : BITSET;
-
- BEGIN
- IF bis > MAX( SetElement ) THEN
- bis := MAX( SetElement );
- END;
-
- IF von <= bis THEN
-
- vonIdx := VAL( CARDINAL, von ) DIV ElementsInBITSET;
- bisIdx := VAL( CARDINAL, bis ) DIV ElementsInBITSET;
-
- vonMaske := SHIFT( { 0..15 },
- VAL( CARDINAL, von ) MOD ElementsInBITSET - 16 );
- bisMaske := SHIFT( { 0..15 },
- VAL( CARDINAL, bis ) MOD ElementsInBITSET + 1 );
-
-
- IF vonIdx = bisIdx THEN
-
- menge[ vonIdx ] := menge[ vonIdx ] * ( vonMaske + bisMaske );
- ELSE
- menge[ vonIdx ] := menge[ vonIdx ] * vonMaske;
- menge[ bisIdx ] := menge[ bisIdx ] * bisMaske;
-
- FOR vonIdx := vonIdx + 1 TO bisIdx - 1 DO
-
- menge[ vonIdx ] := BITSET{ };
- END; (* FOR *)
- END; (* IF vonIdx *)
- END; (* IF von <= *)
- END ExcludeRange;
-
- (*---------------------------------------------------------------------------*)
-
- PROCEDURE Union ((* EIN/ -- *) menge1,
- (* EIN/ -- *) menge2 : Set;
- (* -- /AUS *) VAR verein : Set );
- (*T*)
- VAR Index : CARDINAL;
-
- BEGIN
- FOR Index := 0 TO NoOfBITSETs - 1 DO
- verein[ Index ] := menge1[ Index ] + menge2[ Index ];
- END;
- END Union;
-
- (*---------------------------------------------------------------------------*)
-
- PROCEDURE Intersection ((* EIN/ -- *) menge1,
- (* EIN/ -- *) menge2 : Set;
- (* -- /AUS *) VAR schnitt : Set );
- (*T*)
- VAR Index : CARDINAL;
-
- BEGIN
- FOR Index := 0 TO NoOfBITSETs - 1 DO
- schnitt[ Index ] := menge1[ Index ] * menge2[ Index ];
- END;
- END Intersection;
-
- (*---------------------------------------------------------------------------*)
-
- PROCEDURE Difference ((* EIN/ -- *) menge1,
- (* EIN/ -- *) menge2 : Set;
- (* -- /AUS *) VAR diff : Set );
- (*T*)
- VAR Index : CARDINAL;
-
- BEGIN
- FOR Index := 0 TO NoOfBITSETs - 1 DO
- diff[ Index ] := menge1[ Index ] - menge2[ Index ];
- END;
- END Difference;
-
- (*---------------------------------------------------------------------------*)
-
- PROCEDURE SymmetricDiff ((* EIN/ -- *) menge1,
- (* EIN/ -- *) menge2 : Set;
- (* -- /AUS *) VAR symdiff : Set );
- (*T*)
- VAR Index : CARDINAL;
-
- BEGIN
- FOR Index := 0 TO NoOfBITSETs - 1 DO
- symdiff[ Index ] := menge1[ Index ] / menge2[ Index ];
- END;
- END SymmetricDiff;
-
- (*---------------------------------------------------------------------------*)
-
- PROCEDURE Equal ((* EIN/ -- *) menge1,
- (* EIN/ -- *) menge2 : Set ): BOOLEAN;
- (*T*)
- VAR Index : CARDINAL;
-
- BEGIN
- Index := 0;
-
- WHILE ( Index < NoOfBITSETs ) &
- ( menge1[ Index ] = menge2[ Index ] )
- DO
- INC( Index );
- END;
-
- RETURN( Index = NoOfBITSETs );
-
- END Equal;
-
- (*---------------------------------------------------------------------------*)
-
- PROCEDURE IsSubset ((* EIN/ -- *) menge1,
- (* EIN/ -- *) menge2 : Set ): BOOLEAN;
- (*T*)
- VAR Index : CARDINAL;
-
- BEGIN
- Index := 0;
-
- WHILE ( Index < NoOfBITSETs ) &
- ( menge1[ Index ] <= menge2[ Index ] )
- DO
- (* Nach der ersten BITSET von <menge1> abbrechen,
- * die keine Untermenge der BITSET von <menge2> ist
- *)
- INC( Index );
- END;
-
- RETURN( Index = NoOfBITSETs );
-
- END IsSubset;
-
- (*---------------------------------------------------------------------------*)
-
- PROCEDURE IsProperSubset ((* EIN/ -- *) menge1,
- (* EIN/ -- *) menge2 : Set ): BOOLEAN;
- (*T*)
- VAR Index : CARDINAL;
- Ungleich : BOOLEAN;
-
- BEGIN
- Index := 0;
- Ungleich := FALSE;
-
- WHILE ( Index < NoOfBITSETs ) &
- ( menge1[ Index ] <= menge2[ Index ] )
- DO
- (* Es reicht, wenn nur eine einzige BITSET
- * unterschiedlich ist.
- *)
- Ungleich := Ungleich OR ( menge1[ Index ] # menge2[ Index ] );
- INC( Index );
- END;
-
- RETURN(( Index = NoOfBITSETs ) & Ungleich );
-
- END IsProperSubset;
-
- (*---------------------------------------------------------------------------*)
-
- PROCEDURE IsSuperset ((* EIN/ -- *) menge1,
- (* EIN/ -- *) menge2 : Set ): BOOLEAN;
- (*T*)
- VAR Index : CARDINAL;
-
- BEGIN
- Index := 0;
-
- WHILE ( Index < NoOfBITSETs ) &
- ( menge1[ Index ] >= menge2[ Index ] )
- DO
- INC( Index );
- END;
-
- RETURN( Index = NoOfBITSETs );
-
- END IsSuperset;
-
- (*---------------------------------------------------------------------------*)
-
- PROCEDURE IsProperSuperset ((* EIN/ -- *) menge1,
- (* EIN/ -- *) menge2 : Set ): BOOLEAN;
- (*T*)
- VAR Index : CARDINAL;
- Ungleich : BOOLEAN;
-
- BEGIN
- Index := 0;
- Ungleich := FALSE;
-
- WHILE ( Index < NoOfBITSETs ) &
- ( menge1[ Index ] >= menge2[ Index ] )
- DO
- (* Es reicht, wenn nur eine einzige BITSET
- * unterschiedlich ist.
- *)
- Ungleich := Ungleich OR ( menge1[ Index ] # menge2[ Index ] );
- INC( Index );
- END;
-
- RETURN(( Index = NoOfBITSETs ) & Ungleich );
-
- END IsProperSuperset;
-
- (*---------------------------------------------------------------------------*)
-
- PROCEDURE WriteSet ((* EIN/ -- *) menge : Set);
- (*T*)
- VAR Bitset : INTEGER; (* Falls NoOfBITSETs = 1 *)
- Bit : CARDINAL;
-
- BEGIN
- FOR Bitset := 0 TO NoOfBITSETs - 2 DO
- FOR Bit := 0 TO 15 DO
- IF Bit IN menge[ Bitset ] THEN
- Write('1');
- ELSE
- Write('0');
- END;
- END;
- Write('|');
-
- (* Pro Zeile vier BITSETs ausgeben
- *)
- IF ( Bitset + 1 ) MOD 4 = 0 THEN WriteLn; END;
- END;
-
- (* Letzte BITSET wegen der evtl. zusaetzl.
- * Bits gesondert behandeln
- *)
- FOR Bit := 0 TO LastElements - 1 DO
- IF Bit IN menge[ Bitset ] THEN
- Write('1');
- ELSE
- Write('0');
- END;
- END;
- Write('|');
-
- END WriteSet;
-
- (*---------------------------------------------------------------------------*)
-
- BEGIN (* Sets-Initialisierung *)
-
- (* Mit dieser Maske werden die gueltigen Bits der letzten
- * BITSET maskiert.
- * Das Wort mit dem Wert 0FFFFH - also alle Bits gesetzt -
- * wird um soviele Bits nach links geschoben wie gueltige
- * Bits in der letzten BITSET sind. Dann werden alle Bits
- * invertiert, d.h. dort wo gueltige Bits stehen sollen
- * ( von rechts betrachtet ), sind die Bits der Maske
- * gesetzt, alle weiteren Bits sind geloescht, sodass
- * bei einer UND-Verknuepfung ( durch den Vereinigungs-
- * operator '*' ) alle ungueltigen Bits geloescht werden.
- *)
-
- ElemMask := SHIFT( BITSET{ 0..15 }, LastElements ) / BITSET{ 0..15 };
-
- END LongSets.
-